home *** CD-ROM | disk | FTP | other *** search
- {*******************************************************}
- { }
- { Delphi VCL Extensions (RX) }
- { }
- { Copyright (c) 2001,2002 SGB Software }
- { Copyright (c) 1997, 1998 Fedor Koshevnikov, }
- { Igor Pavluk and Serge Korolev }
- { }
- {*******************************************************}
-
-
- unit QBndDlg;
-
- interface
-
- {$I RX.INC}
-
- uses
- SysUtils, {$IFDEF WIN32} Windows, {$ELSE} WinTypes, WinProcs, {$ENDIF}
- Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, DB
- {$IFNDEF RX_D4}, DBTables {$ENDIF};
-
- type
- TQueryParamsDialog = class(TForm)
- GroupBox1: TGroupBox;
- Label1: TLabel;
- ParamValue: TEdit;
- Label2: TLabel;
- NullValue: TCheckBox;
- OkBtn: TButton;
- CancelBtn: TButton;
- Label3: TLabel;
- TypeList: TComboBox;
- ParamList: TListBox;
- HelpBtn: TButton;
- procedure ParamListChange(Sender: TObject);
- procedure TypeListChange(Sender: TObject);
- procedure ParamValueExit(Sender: TObject);
- procedure NullValueClick(Sender: TObject);
- procedure FormCreate(Sender: TObject);
- procedure OkBtnClick(Sender: TObject);
- procedure HelpBtnClick(Sender: TObject);
- private
- InitList: TParams;
- PressedOK: Boolean;
- InValueExit: Boolean;
- InParamChange: Boolean;
- procedure CheckValue;
- procedure Edit;
- procedure Unbind;
- end;
-
- function EditQueryParams(DataSet: TDataSet; List: TParams;
- AHelpContext: THelpContext {$IFDEF RX_D4} = 0 {$ENDIF}): Boolean;
-
- implementation
-
- uses DbConsts, {$IFDEF RX_D3} BdeConst, {$ENDIF} VclUtils;
-
- {$R *.DFM}
-
- var
- FieldTypes: array[TFieldType] of String;
-
- procedure FillFieldTypes;
- var
- ParamString: string;
- I: Integer;
- J: TFieldType;
- begin
- for J := Low(TFieldType) to High(TFieldType) do
- FieldTypes[J] := EmptyStr;
- ParamString := ResStr(SDataTypes);
- J := Low(TFieldType);
- I := 1;
- while I <= Length(ParamString) do begin
- FieldTypes[J] := ExtractFieldName(ParamString, I);
- Inc(J);
- end;
- end;
-
- function GetFieldType(const Value: string): TFieldType;
- begin
- for Result := Low(TFieldType) to High(TFieldType) do
- if (FieldTypes[Result] <> '') and (FieldTypes[Result] = Value) then Exit;
- Result := ftUnknown;
- end;
-
- procedure ClearFieldTypes;
- var
- I: TFieldType;
- begin
- for I := Low(TFieldType) to High(TFieldType) do begin
- //DisposeStr(FieldTypes[I]);
- FieldTypes[I] := EmptyStr;
- end;
- end;
-
- procedure DoneQBind; far;
- begin
- ClearFieldTypes;
- end;
-
- function EditQueryParams(DataSet: TDataSet; List: TParams;
- AHelpContext: THelpContext {$IFDEF RX_D4} = 0 {$ENDIF}): Boolean;
- begin
- with TQueryParamsDialog.Create(Application) do
- try
- HelpContext := AHelpContext;
- if HelpContext = 0 then begin
- HelpBtn.Visible := False;
- OkBtn.Left := OkBtn.Left + HelpBtn.Width div 2;
- CancelBtn.Left := CancelBtn.Left + HelpBtn.Width div 2;
- end;
- if (csDesigning in DataSet.ComponentState) then
- Caption := Format(ResStr(SParamEditor),
- {$IFDEF RX_D3}
- {$IFDEF CBUILDER}
- [DataSet.Owner.Name, '->', DataSet.Name]);
- {$ELSE}
- {$IFDEF RX_D4}
- [DataSet.Owner.Name, '.', DataSet.Name]);
- {$ELSE}
- [DataSet.Owner.Name, DataSet.Name]);
- {$ENDIF}
- {$ENDIF}
- {$ELSE}
- [DataSet.Owner.Name, DataSet.Name]);
- {$ENDIF}
- InitList := List;
- Edit;
- Result := PressedOk;
- finally
- Free;
- end;
- end;
-
- procedure TQueryParamsDialog.Edit;
- var
- I: Integer;
- J: TFieldType;
- begin
- for J := Low(TFieldType) to High(TFieldType) do
- if (FieldTypes[J] <> '') and (FieldTypes[J] <> '') then TypeList.Items.Add(FieldTypes[J]);
- if InitList.Count = 0 then begin
- ParamValue.Enabled := False;
- NullValue.Enabled := False;
- TypeList.Enabled := False;
- ParamList.Enabled := False;
- end
- else begin
- for I := 0 to InitList.Count - 1 do
- if ParamList.Items.IndexOf(InitList[I].Name) = -1 then
- ParamList.Items.Add(InitList[I].Name);
- ParamList.ItemIndex := 0;
- ParamListChange(Self);
- ActiveControl := OkBtn;
- end;
- PressedOk := ShowModal = mrOK;
- end;
-
- procedure TQueryParamsDialog.ParamListChange(Sender: TObject);
- begin
- InParamChange := True;
- try
- with InitList.ParamByName(ParamList.Items[ParamList.ItemIndex]) do
- begin
- if (FieldTypes[DataType] <> '') and (FieldTypes[DataType] <> '') then begin
- with TypeList do ItemIndex := Items.IndexOf(FieldTypes[DataType]);
- if Bound then ParamValue.Text := AsString
- else ParamValue.Text := '';
- end
- else begin
- TypeList.ItemIndex := -1;
- ParamValue.Text := '';
- end;
- NullValue.Checked := IsNull;
- end;
- finally
- InParamChange := False;
- end;
- end;
-
- procedure TQueryParamsDialog.TypeListChange(Sender: TObject);
- begin
- with InitList.ParamByName(ParamList.Items[ParamList.ItemIndex]) do
- begin
- DataType := GetFieldType(TypeList.Text);
- ParamValue.Text := '';
- NullValue.Checked := IsNull;
- end;
- end;
-
- procedure TQueryParamsDialog.ParamValueExit(Sender: TObject);
- begin
- if InValueExit or (ActiveControl = CancelBtn) then Exit;
- InValueExit := True;
- try
- if ParamValue.Text <> '' then NullValue.Checked := False;
- if (TypeList.Text = '') and TypeList.CanFocus then begin
- TypeList.SetFocus;
- raise Exception.Create(ResStr(SInvalidParamFieldType));
- end;
- if ParamValue.Text = '' then
- with InitList.ParamByName(ParamList.Items[ParamList.ItemIndex]) do
- begin
- if NullValue.Checked then Clear
- else Unbind;
- end
- else CheckValue;
- finally
- InValueExit := False;
- end;
- end;
-
- procedure TQueryParamsDialog.CheckValue;
- begin
- try
- with InitList.ParamByName(ParamList.Items[ParamList.ItemIndex]) do begin
- if (DataType in [ftDate, ftTime, ftDateTime]) and
- (CompareText(ParamValue.Text, 'Now') = 0) then
- begin
- case DataType of
- ftDate: Text := DateToStr(SysUtils.Date);
- ftTime: Text := TimeToStr(SysUtils.Time);
- ftDateTime: Text := DateTimeToStr(SysUtils.Now);
- end;
- end
- else Text := ParamValue.Text;
- end;
- except
- with ParamValue do begin
- if CanFocus then SetFocus;
- SelectAll;
- end;
- raise;
- end;
- end;
-
- procedure TQueryParamsDialog.Unbind;
- begin
- with InitList.ParamByName(ParamList.Items[ParamList.ItemIndex]) do
- begin
- AsInteger := 1;
- DataType := GetFieldType(TypeList.Text);
- Bound := False;
- end;
- end;
-
- procedure TQueryParamsDialog.NullValueClick(Sender: TObject);
- begin
- if InParamChange then Exit;
- if NullValue.Checked then
- with InitList.ParamByName(ParamList.Items[ParamList.ItemIndex]) do
- begin
- Clear;
- ParamValue.Text := '';
- end
- else Unbind;
- end;
-
- procedure TQueryParamsDialog.OkBtnClick(Sender: TObject);
- begin
- if not TypeList.Enabled then Exit;
- try
- ParamValueExit(Sender);
- except
- ModalResult := 0;
- raise;
- end;
- end;
-
- procedure TQueryParamsDialog.HelpBtnClick(Sender: TObject);
- begin
- Application.HelpContext(HelpContext);
- end;
-
- procedure TQueryParamsDialog.FormCreate(Sender: TObject);
- begin
- {$IFNDEF WIN32}
- Font.Style := [fsBold];
- {$ENDIF}
- end;
-
- initialization
- FillFieldTypes;
- {$IFDEF WIN32}
- finalization
- DoneQBind;
- {$ELSE}
- AddExitProc(DoneQBind);
- {$ENDIF}
- end.